home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-19
/
feb93.zip
/
ACAD.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1993-02-12
|
4KB
|
125 lines
; ACAD.LSP
;; General AutoLisp Command File
;; Version 4.0
;; (c) Copyright 1987, 1988, 1989, 1990, 1991, 1992
;; BURNS & McDONNELL Engineering Company
;; 4800 E. 63rd Street
;; Kansas City, Mo. 64130
;; 816-333-4375
;;
;; By: Mark Scott - MicroCAD Applications Programmer
(vmon)
(setvar "cmdecho" 0)
(defun dtr(a) (* pi (/ a 180.0)))
(defun rtd(a) (* (/ a pi) 180.0))
(defun s_vars ()
(setq sv_cmd (getvar "cmdecho")
sv_blip (getvar "blipmode")
sv_high (getvar "highlight")
sv_drag (getvar "dragmode")
)
)
(defun r_vars ()
(setvar "blipmode" sv_blip)
(setvar "highlight" sv_high)
(setvar "dragmode" sv_drag)
(setvar "cmdecho" sv_cmd)
(princ)
)
;;;
;;; AutoLOAD error function
;;;
(defun alerror (s)
(if (/= s "Function cancelled")
(progn
(princ (strcat "\nAutoload error on line " (itoa linenum)))
(princ (strcat "\nError: " s " in file " val))
(princ "\nCannot continue loading files...")
)
)
(setq S nil)
(setq *error* origerr) ; Restore old *error* handler
(prin1)
)
;;;
;;; AutoLOAD
;;;
(defun autoload ()
(setq origerr *error*
*error* alerror)
;; Look for file autoload.lst in c:\acad\support
(setq chk4alf nil
chk4alf (findfile "autoload.lst")
linenum 0
)
(if (not chk4alf)
;;THEN
(princ "\n*ERROR* autoload.lst file not found ...")
;;ELSE
(progn
(setq alf (open chk4alf "r"))
(while (setq val (read-line alf)) ;; Read the next line in file
(setq val (strcase val))
(if (= (substr val 1 1) ";") ; = Commented portion of file
;;THEN
(setq linenum (1+ linenum))
;;ELSE
(progn
(setq linenum (1+ linenum))
(setq sl (strlen val))
(if (/= (substr val (- sl 3) 1) ".")
;;THEN
(princ (strcat "\n*ERROR* in line " (itoa linenum) " of
autoload.lst file, no extension. "))
;;ELSE
(progn
(setq ext (substr val (- sl 2)))
(cond
((= ext "LSP")
(progn
(princ (strcat "\nLoading " val " ..."))
(load val)
)
)
((= ext "EXP")
(progn
(princ (strcat "\nXLoading " val " ..."))
(xload val)
)
)
(t (progn
(princ (strcat "\nError on line "
(itoa linenum)))
(princ (strcat " in file Autoload.lst [" val
"]"))
(princ "\nInvalid extension type")
(getstring "... press Return to continue ...")
)
)
)
)
)
)
)
)
)
)
(close alf)
(setq *error* origerr)
(princ "\nAll files in AUTOLOAD.LST have been loaded ...")
(prin1)
)
(autoload) ;; calls AutoLOAD after loading
(setq autoload nil) ;; frees up memory not needed by autoload anymore...
(princ "\nBurns & McDonnell - ACAD.LSP - Release 11 - 1992")
(prin1)